home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 March - Disc 1 / Macworld (1999-03) (Disk 1).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / SystemCode / alphaHooks.tcl < prev    next >
Encoding:
Text File  |  1998-12-20  |  22.1 KB  |  705 lines  |  [TEXT/ALFA]
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  Vince's Additions - an extension package for Alpha
  4.  # 
  5.  #  FILE: "alphaHooks.tcl"
  6.  #                                    created: 18/7/97 {5:10:18 pm} 
  7.  #                                last update: 20/12/1998 {10:57:44 pm} 
  8.  #  Author: Vince Darley
  9.  #  E-mail: <darley@fas.harvard.edu>
  10.  #    mail: Division of Engineering and Applied Sciences, Harvard University
  11.  #          Oxford Street, Cambridge MA 02138, USA
  12.  #     www: <http://www.fas.harvard.edu/~darley/>
  13.  #  
  14.  # Copyright (c) 1997-1998  Vince Darley, all rights reserved
  15.  #  
  16.  # Description: 
  17.  #  
  18.  #  Here are the current hooks:
  19.  #  
  20.  #  activateHook changeMode closeHook deactivateHook modifyModeFlags 
  21.  #  quitHook resumeHook saveasHook saveHook savePostHook suspendHook
  22.  #  openHook
  23.  #  
  24.  #  There's also a 'mode::init' hook which will be called the first
  25.  #  time a mode is started up.  Note that the mode exists, but its
  26.  #  variables have not yet been made global, and its menus have not
  27.  #  yet been inserted into the menu bar.
  28.  #  
  29.  #  There's also a 'startupHook' which is called when Alpha starts
  30.  #  up, but after all other initialisation has taken place (before
  31.  #  any files are opened though).
  32.  #  
  33.  #  There's also a 'launch' hook for when an app is launched.
  34.  #  
  35.  #  Use of such lists as 'savePostHooks' is obsolete.
  36.  #  These lists are ignored, use hook::register instead.
  37.  #  
  38.  #  History
  39.  # 
  40.  #  modified by  rev reason
  41.  #  -------- --- --- -----------
  42.  #  18/7/97  VMD 1.0 original
  43.  #  22/7/97  VMD 1.1 fixed all bugs ;-) and added the above examples.
  44.  # ###################################################################
  45.  ##
  46.  
  47. namespace eval mode {}
  48. namespace eval win {}
  49.  
  50. lappend mode::procs carriageReturn OptionTitleBar OptionTitleBarSelect \
  51.   electricLeft electricRight electricSemi indentLine indentRegion \
  52.   parseFuncs MarkFile
  53.  
  54. proc saveHook name {
  55.     global backup backupExtension backupFolder mode win::Modes \
  56.       backupAgeRequirementInHours
  57.     hook::callAll saveHook [set win::Modes($name)] $name 
  58.     if {$backup} {
  59.     set dir $backupFolder
  60.     
  61.     if {![string length $dir]} {
  62.         set dir [file dirname $name]
  63.     }
  64.     if {![file exists $dir]} {
  65.         if {[dialog::yesno "Create backup dir '$dir'?"]} {
  66.         mkdir $dir
  67.         }
  68.     }
  69.     set backfile [file join $dir [file tail $name]$backupExtension]
  70.     if {[file exists $backfile]} {
  71.         getFileInfo $name a
  72.         if {[expr {([now] - $a(modified) + 0.0)/3600}] < $backupAgeRequirementInHours} {
  73.         return
  74.         }
  75.         catch {file delete $backfile}
  76.     }
  77.     message "Backing up…$backfile"
  78.     catch {file copy $name $backfile}
  79.     }
  80. }
  81.  
  82. proc saveUnmodified {} {
  83.     set name [win::Current]
  84.     if {[file exists $name] || \
  85.       ([regsub { <\w+>$} $name {} name] && [file exists $name])} {
  86.     getFileInfo $name arr
  87.     set mod $arr(modified)
  88.     save
  89.     setFileInfo $name modified $mod
  90.     return
  91.     }
  92.     # shouldn't really get here!
  93.     error "File doesn't exist"
  94. }
  95.  
  96. ## 
  97.  # -------------------------------------------------------------------------
  98.  # 
  99.  # "changeMode" --
  100.  # 
  101.  #  A very important procedure.  It handles all switching from one mode
  102.  #  to another.  This means it has to adjust menus, floating windows,
  103.  #  global variables, mode prefs, and call a number of hooks.
  104.  #  
  105.  #  It maintains a list of variables which the new mode over-rides from
  106.  #  the global scope, and recreates them.  This allows a mode to have
  107.  #  its own value for a global variable without messing anything up.
  108.  # -------------------------------------------------------------------------
  109.  ##
  110. proc changeMode {newMode} {
  111.     global lastMode dummyProc mode seenMode PREFS
  112.     global global::_vars mode::features global::features
  113.     
  114.     set lastMode $mode
  115.     set mode $newMode
  116.     if {$lastMode == $mode} {
  117.         if {$newMode != ""} {
  118.         displayMode $newMode
  119.     }
  120.         return
  121.     }
  122.     if {$lastMode == ""} {
  123.     renameMenuItem -m Config "Mode Prefs" "${mode} Mode Prefs"
  124.     catch {menuEnableHook 1}
  125.     } elseif {$mode == ""} {
  126.     renameMenuItem -m Config "${lastMode} Mode Prefs" "Mode Prefs"
  127.     catch {menuEnableHook 0}
  128.     } else {
  129.     renameMenuItem -m Config "${lastMode} Mode Prefs" "${mode} Mode Prefs"
  130.     }
  131.     
  132.     global ${lastMode}modeVars
  133.     if {[info exists ${lastMode}modeVars]} {
  134.         foreach v [array names ${lastMode}modeVars] {
  135.             global $v
  136.             catch {unset $v}
  137.         }
  138.     }
  139.     floatShowHide off $lastMode
  140.     if {[info exists global::_vars]} { 
  141.     uplevel \#0 ${global::_vars}
  142.     unset global::_vars
  143.     }
  144.     if {[info exists mode::features($mode)]} {
  145.     set onoff [package::onOrOff [set mode::features($mode)] $lastMode]
  146.     } else {
  147.     set onoff [package::onOrOff "" $lastMode]
  148.     }
  149.     
  150.     foreach m [lindex $onoff 0] {
  151.     package::deactivate $m
  152.     }
  153.     
  154.     # These lines must load the mode vars into the mode var scope.
  155.     if {[info exists dummyProc($mode)]} { $dummyProc($mode) }
  156.     if {![info exists seenMode($mode)]} {
  157.     hook::callAll mode::init $mode
  158.     }
  159.     # once the vars are in mode-var scope (= the <mode>modeVars array),
  160.     # they can be transfered to the global scope.  A future version of
  161.     # Alpha with Tcl8.0 namespaces may not need to do this.
  162.     global ${mode}modeVars
  163.     if {[info exists ${mode}modeVars]} {
  164.         foreach v [array names ${mode}modeVars] {
  165.             global $v
  166.         if {[info exists $v]} { append global::_vars "set $v \{[set $v]\} ;" }
  167.             set $v [set ${mode}modeVars($v)]
  168.         }
  169.     }
  170.     foreach m [lindex $onoff 1] {
  171.     package::activate $m
  172.     }
  173.     
  174.     floatShowHide on $mode
  175.  
  176.     if {![info exists seenMode($mode)]} {
  177.     global mode::procs
  178.     #foreach p ${mode::procs} {
  179.     #    if {[info commands ${mode}::${p}] == ""} {
  180.     #    auto_load ${mode}::${p}
  181.     #    }
  182.     #}
  183.     set seenMode($mode) 1
  184.     if {($mode != "") && [file exists [file join $PREFS ${mode}Prefs.tcl]]} {
  185.         if {[catch {uplevel \#0 [list source [file join $PREFS ${mode}Prefs.tcl]]}]} {
  186.                 alertnote "Your preferences file '${mode}Prefs.tcl has an error."
  187.             } 
  188.         }
  189.     }
  190.         
  191.     if {$newMode != ""} {
  192.     displayMode $newMode
  193.     }
  194.  
  195.     hook::callAll changeMode $mode $mode
  196. }
  197.  
  198. ## 
  199.  # -------------------------------------------------------------------------
  200.  # 
  201.  # "requireOpenWindowsHook" --
  202.  # 
  203.  #  En-/disable meaningless menu items which would require the presence
  204.  #  of a certain number of windows to be active
  205.  #  
  206.  #  This proc should only be called from 'openHook' and 'closeHook'.
  207.  #  
  208.  #  You can register with it using 
  209.  #  
  210.  #  'hook::register requireOpenWindowsHook [list menu item] N'
  211.  #  
  212.  #  where 'N' is the number of windows required (1 or 2 usually)
  213.  #  (and deregister etc using hook::deregister).
  214.  #  
  215.  #  We only really need the catch in here for two reasons:
  216.  #  (i) in case bad menus are registered accidentally
  217.  #  (ii) so startup errors can open a window without hitting another error
  218.  #  in the middle of doing that!
  219.  # -------------------------------------------------------------------------
  220.  ##
  221. proc requireOpenWindowsHook {requiredNum} {
  222.     foreach count $requiredNum {
  223.     set enable [expr {[llength [winNames]] >= $requiredNum ? 1 : 0}]
  224.     foreach i [hook::list requireOpenWindowsHook $requiredNum] {
  225.         catch "enableMenuItem $i $enable"
  226.     }
  227.     }
  228. }
  229.  
  230. ## 
  231.  # -------------------------------------------------------------------------
  232.  # 
  233.  # "menuEnableHook" --
  234.  # 
  235.  #  This hook is called to turn menu items on or off.  It is called 
  236.  #  whenever there are no windows, or when we go from 0->1 window.
  237.  #  
  238.  #  It should deal with all standard menus.  It does not deal with
  239.  #  special menu items like 'save', 'revert',.. which require more
  240.  #  information.
  241.  #  
  242.  #  It is called from changeMode.
  243.  #  
  244.  #  Andreas wrote most of this proc.
  245.  #  
  246.  #  Due to a deficiency in MacOS/MercutioMDEF/Alpha (not sure who
  247.  #  the culprit is!), key-bindings attached to menu items are still
  248.  #  triggered even if the menu item is inactive.
  249.  # -------------------------------------------------------------------------
  250.  ##
  251. proc menuEnableHook {{haveWin 1}} {
  252.     global winMenu mode
  253.     # we only get here if there are no windows, or 1 window which we
  254.     # just opened.  Otherwise nothing will be different to last time.
  255.     enableMenuItem File close $haveWin
  256.     enableMenuItem File closeAll $haveWin
  257.     enableMenuItem File closeFloat $haveWin
  258.     enableMenuItem File saveAs… $haveWin
  259.     enableMenuItem File saveACopyAs… $haveWin
  260.     if {[package::active printerChoicesMenu]} {
  261.     enableMenuItem File print $haveWin
  262.     } else {
  263.     enableMenuItem File print… $haveWin
  264.     }
  265.     enableMenuItem File printAll $haveWin
  266.     eval [lindex [list un {}] $haveWin]Bind 'p' <c> print
  267.     
  268.     enableMenuItem Edit undo $haveWin
  269.     enableMenuItem Edit redo $haveWin
  270.     enableMenuItem Edit evaluate $haveWin
  271.     enableMenuItem Edit cut $haveWin
  272.     enableMenuItem Edit cut&Append $haveWin
  273.     enableMenuItem Edit copy $haveWin
  274.     enableMenuItem Edit copy&Append $haveWin
  275.     enableMenuItem Edit paste $haveWin
  276.     enableMenuItem Edit pastePop $haveWin
  277.     enableMenuItem Edit selectAll $haveWin
  278.     enableMenuItem Edit selectParagraph $haveWin
  279.     enableMenuItem Edit clear $haveWin
  280.     enableMenuItem Edit twiddle $haveWin
  281.     enableMenuItem Edit twiddleWords $haveWin
  282.     enableMenuItem Edit shiftLeft  $haveWin
  283.     enableMenuItem Edit shiftLeftSpace  $haveWin
  284.     enableMenuItem Edit shiftRight  $haveWin
  285.     enableMenuItem Edit shiftRightSpace  $haveWin
  286.     enableMenuItem Edit balance  $haveWin
  287.     enableMenuItem Edit emacs $haveWin
  288.  
  289.     if {[info tclversion] < 8.0} {
  290.         enableMenuItem Text fillParagraph $haveWin
  291.         enableMenuItem Text wrapParagraph $haveWin
  292.         enableMenuItem Text sentenceParagraph $haveWin
  293.         enableMenuItem Text fillRegion $haveWin
  294.         enableMenuItem Text wrapRegion $haveWin
  295.         enableMenuItem Text sentenceRegion $haveWin
  296.         enableMenuItem Text paragraphToLine $haveWin
  297.         enableMenuItem Text lineToParagraph $haveWin
  298.         enableMenuItem Text reverseSort $haveWin
  299.         enableMenuItem Text sortLines $haveWin
  300.         enableMenuItem Text sortParagraphs $haveWin
  301.         enableMenuItem Text zapInvisibles $haveWin
  302.         enableMenuItem Text tabsToSpaces $haveWin
  303.         enableMenuItem Text spacesToTabs $haveWin
  304.         enableMenuItem Text indentLine $haveWin
  305.         enableMenuItem Text indentSelection $haveWin
  306.         enableMenuItem Text upcaseRegion $haveWin
  307.         enableMenuItem Text downcaseRegion $haveWin
  308.         enableMenuItem Text strings $haveWin
  309.         enableMenuItem Text commentLine $haveWin
  310.         enableMenuItem Text uncommentLine $haveWin
  311.         enableMenuItem Text commentBox $haveWin
  312.         enableMenuItem Text uncommentBox $haveWin
  313.         enableMenuItem Text commentParagraph $haveWin
  314.         enableMenuItem Text uncommentParagraph $haveWin
  315.     enableMenuItem Config "Mode Prefs" $haveWin
  316.     } else {
  317.     enableMenuItem Text "" $haveWin
  318.     if {$mode == ""} {
  319.         enableMenuItem -m Config "Mode Prefs" $haveWin
  320.     } else {
  321.         enableMenuItem -m Config "${mode} Mode Prefs" $haveWin
  322.     }
  323.     }
  324.     
  325.     enableMenuItem Search searchStart $haveWin
  326.     enableMenuItem Search findAgain $haveWin
  327.     enableMenuItem Search findAgainBackward $haveWin
  328.     if { ![string compare [searchString] ""] && !$haveWin } {
  329.     enableMenuItem Search findInNextFile $haveWin
  330.     } else {
  331.     enableMenuItem Search findInNextFile 1
  332.     }
  333.     enableMenuItem Search enterSearchString $haveWin
  334.     enableMenuItem Search enterReplaceString $haveWin
  335.     enableMenuItem Search quickFind $haveWin
  336.     enableMenuItem Search quickFindRegexp $haveWin
  337.     enableMenuItem Search reverseQuickFind $haveWin
  338.     enableMenuItem Search replace $haveWin
  339.     enableMenuItem Search replace&FindAgain $haveWin
  340.     enableMenuItem Search replaceAll $haveWin
  341.     enableMenuItem Search placeBookmark $haveWin
  342.     enableMenuItem Search returnToBookmark $haveWin
  343.     enableMenuItem Search gotoLine $haveWin
  344.     enableMenuItem Search matchingLines $haveWin
  345.     enableMenuItem Search gotoMatch $haveWin
  346.     enableMenuItem Search nextMatch $haveWin
  347.     enableMenuItem Search gotoFunc $haveWin
  348.     # These four don't work because of a bug in Alpha.
  349.     # It won't recognise items near the end of long menus
  350.     # (long is > 20 items or so).  We leave them in hoping
  351.     # for the future...
  352.     enableMenuItem Search gotoFileMark $haveWin
  353.     enableMenuItem Search markHilite $haveWin
  354.     enableMenuItem Search namedMarks $haveWin
  355.     enableMenuItem Search unnamedMarks $haveWin
  356.     
  357.     enableMenuItem Utils AsciiEtc $haveWin
  358.     enableMenuItem Utils cmdDoubleClick $haveWin
  359.     enableMenuItem Utils winUtils $haveWin
  360.     enableMenuItem Utils spellcheckWindow $haveWin
  361.     enableMenuItem Utils spellcheckSelection $haveWin
  362.     enableMenuItem Utils wordCount $haveWin
  363.     
  364.     enableMenuItem Config setFontsTabs… $haveWin
  365.     
  366.     enableMenuItem $winMenu zoom $haveWin
  367.     enableMenuItem $winMenu singlePage $haveWin
  368.     enableMenuItem $winMenu chooseAWindow $haveWin
  369.     enableMenuItem $winMenu iconify $haveWin
  370.     enableMenuItem $winMenu arrange $haveWin
  371.     enableMenuItem $winMenu splitWindow $haveWin
  372.     enableMenuItem $winMenu toggleScrollbar $haveWin
  373.     
  374.     if {!$haveWin} {
  375.     enableMenuItem File save 0
  376.     enableMenuItem File saveUnmodified 0
  377.     enableMenuItem File revert 0
  378.     enableMenuItem File revertToBackup 0
  379.     enableMenuItem File renameTo… 0
  380.     enableMenuItem File saveAll 0
  381.     }
  382.     
  383.     requireOpenWindowsHook 1
  384. }
  385.  
  386. proc savePostHook name {
  387.     hook::callAll savePostHook "" $name
  388. }
  389.  
  390. proc closeHook name {
  391.     global markStack win::Modes win::Active win::Current win::Dirty win::NumDirty
  392.     hook::callAll closeHook [set win::Modes($name)] $name
  393.  
  394.     if {[info exists win::Dirty($name)]} {
  395.     incr win::NumDirty -1
  396.     unset win::Dirty($name)
  397.     enableMenuItem File saveAll [expr {${win::NumDirty} ? 1 : 0}]
  398.     }
  399.         
  400.     unset win::Modes($name)
  401.     if {[llength $markStack]} {
  402.         set markStack [lremove -glob $markStack $name*]
  403.     }
  404.     win::removeFromMenu $name
  405.  
  406.     if {[set ind [lsearch -exact ${win::Active} $name]] >= 0} {
  407.         set win::Active [lreplace ${win::Active} $ind $ind]
  408.     }
  409.     if {![llength [winNames]]} {
  410.     set win::Current ""
  411.     changeMode {}
  412.     }
  413.     requireOpenWindowsHook 2
  414. }
  415.  
  416. proc deactivateHook name {
  417.     hook::callAll deactivateHook "" $name
  418. }
  419.  
  420. proc suspendHook name {
  421.     hook::callAll suspendHook "" $name
  422.     global iconifyOnSwitch
  423.     global suspIconed
  424.     if {$iconifyOnSwitch} {
  425.         set wins [winNames -f]
  426.         set suspIconed ""
  427.         foreach win $wins {
  428.             if {![icon -f "$win" -q]} {
  429.                 lappend suspIconed $win
  430.                 icon -f "$win" -t
  431.             }
  432.         }
  433.         set suspIconed [lreverse $suspIconed]
  434.     }
  435. }
  436.  
  437. ensureset killCompilerErrors 0
  438. proc resumeHook name {
  439.     global iconifyOnSwitch resumeRevert suspIconed killCompilerErrors
  440.     
  441.     if {$killCompilerErrors} {
  442.     set wins [winNames -f]
  443.     if {[set res [lsearch $wins "*Compiler Errors*"]] >= 0} {
  444.         bringToFront [lindex $wins $res]
  445.         killWindow
  446.     }
  447.     }
  448.     
  449.     if {$iconifyOnSwitch && [info exists suspIconed]} {
  450.     set wins [winNames -f]
  451.     foreach win $suspIconed {
  452.         icon -f "$win" -o
  453.     }
  454.     unset suspIconed
  455.     }
  456.     if {$resumeRevert} {
  457.     set resumeRevert 0
  458.     revert
  459.     }
  460.     hook::callAll resumeHook "" $name
  461. }
  462.  
  463. ## 
  464.  # -------------------------------------------------------------------------
  465.  # 
  466.  # "saveasHook" --
  467.  # 
  468.  #  Called when saving a window which doesn't yet exist as a file
  469.  #  (in particular 'Untitled' windows) or when the user selects
  470.  #  saveAs.
  471.  # -------------------------------------------------------------------------
  472.  ##
  473. proc saveasHook {oldName newName} {
  474.     global win::Modes win::Active win::Current
  475.     if {$oldName == $newName} return
  476.     win::removeFromMenu $oldName
  477.     win::addToMenu $newName
  478.     win::setMode $newName
  479.     changeMode [set win::Modes($newName)]
  480.     
  481.     if {[set ind [lsearch -exact ${win::Active} $oldName]] >= 0} {
  482.     set win::Active [linsert [lreplace ${win::Active} $ind $ind] 0 $newName]
  483.     } else {
  484.     # hmmm! this is bad.  The old window has gone!
  485.     set win::Active [linsert ${win::Active} 0 $newName]
  486.     }
  487.     
  488.     set win::Current $newName
  489.     catch {unset win::Modes($oldName)}
  490.     hook::callAll saveasHook [set win::Modes($newName)] $oldName $newName
  491.     refresh
  492. }
  493.  
  494. ## 
  495.  # -------------------------------------------------------------------------
  496.  # 
  497.  # "saveACopyAs" --
  498.  # 
  499.  # Finally a proc to add to your collection of Alpha bugs.
  500.  # copyFile has an interesting bug. If the destination file exists it
  501.  # puts the file in [pwd] instead. This proc makes sure it is removed first.
  502.  #  
  503.  # (This proc actually has nothing to do with hooks, but seemed to fit here)
  504.  # -------------------------------------------------------------------------
  505.  ##
  506. proc saveACopyAs {} {
  507.     if {[file exists [set nm [stripNameCount [win::Current]]]]} {
  508.     set nm2 [putfile "Save a copy as:" [file tail $nm]]
  509.     if {[file exists $nm2]} {file delete $nm2}
  510.     file copy $nm $nm2
  511.     }
  512. }
  513.  
  514.  
  515. ensureset win::Active ""
  516.  
  517. proc activateHook {name} {
  518.     global win::Modes win::Active win::Current
  519.     
  520.     if {![info exists win::Modes($name)]} {
  521.     win::setMode $name
  522.     }
  523.     if {[set ind [lsearch -exact ${win::Active} $name]] == -1} {
  524.     set win::Active [linsert ${win::Active} 0 $name]
  525.     } elseif {$ind >= 1} {
  526.     set win::Active [linsert [lreplace ${win::Active} $ind $ind] 0 $name]
  527.     }
  528.     set win::Current $name
  529.     
  530.     changeMode [set win::Modes($name)]
  531.     
  532.     hook::callAll activateHook [set win::Modes($name)] $name
  533.     
  534.     # if the file exists (this seems to be the quickest way to check)
  535.     if {[file exists $name] || \
  536.       ([regsub { <[0-9]+>$} $name {} nm] && [file exists $nm])} {
  537.     # this fails if the window is just opening, but then we know it's clean
  538.     if {[catch {getWinInfo -w $name arr}]} {
  539.         set dirty 0
  540.     } else {
  541.         set dirty $arr(dirty)
  542.     }
  543.     enableMenuItem File save $dirty
  544.     enableMenuItem File saveUnmodified $dirty
  545.     enableMenuItem File revert $dirty
  546.     enableMenuItem File revertToBackup 1
  547.     enableMenuItem File renameTo… 1
  548.     enableMenuItem Edit undo $dirty
  549.     } else {
  550.     enableMenuItem File save 0
  551.     enableMenuItem File saveUnmodified 0
  552.     enableMenuItem File revert 0
  553.     enableMenuItem File revertToBackup 0
  554.     enableMenuItem File renameTo… 0
  555.     enableMenuItem Edit undo 0
  556.     }
  557.     
  558. }
  559.  
  560. proc quitHook {} {
  561.     global PREFS alpha::tracingChannel
  562.     if {[file exists [file join $PREFS ftpTmp]]} {
  563.         catch {rm [file join $PREFS ftpTmp *]}
  564.     }
  565.     catch {close ${alpha::tracingChannel}}
  566.     saveModifiedVars
  567.     hook::callAll quitHook
  568. }
  569.  
  570. ## 
  571.  # -------------------------------------------------------------------------
  572.  # 
  573.  # "dirtyHook" --
  574.  # 
  575.  #  This proc currently has to keep track in the array 'win::Dirty' of
  576.  #  the dirty status of windows.  Its only use is if we close a dirty
  577.  #  window and select 'discard', we would otherwise have a faulty
  578.  #  'win::NumDirty' count.  If there's a different solution we should
  579.  #  get rid of the win::Dirty array.
  580.  #  
  581.  #  Note: closeHook is called after the window is gone, and killWindow
  582.  #  isn't called if you click in the close-box, so they don't solve
  583.  #  the problem.
  584.  # -------------------------------------------------------------------------
  585.  ##
  586. proc dirtyHook {name dirty} {
  587.     global winMenu win::NumDirty win::Dirty
  588.     markMenuItem -m $winMenu [file tail $name] $dirty "◊"
  589.     if {$dirty == "on" || $dirty == 1} {
  590.     set win::Dirty($name) 1
  591.     incr win::NumDirty 1
  592.     } else {
  593.     catch {unset win::Dirty($name)}
  594.     incr win::NumDirty -1
  595.     }
  596.     enableMenuItem File save $dirty
  597.     enableMenuItem File saveUnmodified $dirty
  598.     enableMenuItem File revert $dirty
  599.     enableMenuItem File saveAll [expr {${win::NumDirty} ? 1 : 0}]
  600.     # we may still revertToBackup even if the file is clean.
  601.     # however we can't just revert.
  602.     enableMenuItem Edit undo $dirty
  603. }
  604.  
  605. proc openHook name {
  606.     global win::Modes autoMark mode screenHeight screenWidth \
  607.       forceMainScreen
  608.  
  609.     changeMode [set win::Modes($name)]
  610.     regsub -all {\\([][])} $name {\1} nm
  611.     win::addToMenu $nm
  612.     message ""
  613.  
  614.     if {[file exists $name] && (![catch {getFileInfo $name info}])} {
  615.         if {[info exists info(creator)] && ($info(creator) == {ttxt})} {
  616.             setWinInfo dirty 0
  617.         }
  618.         if {[info exists info(type)] && ($info(type) == {ttro})} {
  619.             catch {setWinInfo read-only 1}
  620.             message "Read-only!"
  621.         }
  622.     }
  623.  
  624.     global ${mode}modeVars
  625.     
  626.     if {$forceMainScreen} {
  627.         set geo [getGeometry]
  628.         set l [lindex $geo 0]; set t [lindex $geo 1]; set w [lindex $geo 2]; set h [lindex $geo 3]; 
  629.         if {($l < 0) || ($t < 35) || ([expr {$l + $w}] > $screenWidth) || ([expr {$t + $h + 18}] > $screenHeight)} {
  630.             singlePage
  631.         }
  632.     }
  633.     getWinInfo arr
  634.     if {!$arr(read-only)} {
  635.     if {[info exists ${mode}modeVars(autoMark)] \
  636.       && [set ${mode}modeVars(autoMark)] \
  637.       && ![llength [getNamedMarks -n]]} {
  638.         markFile
  639.     }
  640.     }
  641.     if {[regexp {\(tabsize:([0-9]+)\)} \
  642.       [getText [minPos] [nextLineStart [minPos]]] "" tabs]} {
  643.     setWinInfo tabsize $tabs
  644.     }
  645.     global PREFS
  646.     if {[string match "${PREFS}*defs.tcl" $name]} {setWinInfo read-only 1}
  647.     
  648.     requireOpenWindowsHook 2
  649.     
  650.     hook::callAll openHook [set win::Modes($name)] $name
  651. }
  652.  
  653. ## 
  654.  # -------------------------------------------------------------------------
  655.  # 
  656.  # "fileMovedHook" --
  657.  # 
  658.  #  Called by Alpha when a window's file has been moved behind our back.
  659.  #  (Only for Alpha using Tcl 8.0)
  660.  # -------------------------------------------------------------------------
  661.  ##
  662. proc fileMovedHook {from to} {
  663.     global win::Active winNumToName winNameToNum
  664.     if {[info exists winNameToNum($from)]} {
  665.     set i $winNameToNum($from)
  666.     unset winNameToNum($from)
  667.     set winNumToName($i) $to
  668.     set winNameToNum($to) $i
  669.     } else {
  670.     alertnote "Can't find old window.  Bad error."
  671.     }
  672.     set idx [lsearch -exact ${win::Active} $from]
  673.     if {$idx >= 0} {
  674.     set win::Active [lreplace ${win::Active} $idx $idx $to]
  675.     } else {
  676.     alertnote "Can't find the old window! Bad error in fileMovedHook."
  677.     }
  678.     hook::callAll fileMovedHook $from $to
  679. }
  680.  
  681. proc revertToBackup {} {
  682.     global backup backupExtension backupFolder win::Modes 
  683.  
  684.     set fname [win::Current]
  685.     set bname [file join $backupFolder [file tail $fname]$backupExtension]
  686.     if {![file exists $bname]} {
  687.         message "Backup file '$bname' does not exist"
  688.         return
  689.     }
  690.     
  691.     if {[dialog::yesno "Revert to backup dated '[join [mtime [file mtime $bname]]]'?"]} {
  692.         killWindow
  693.         
  694.         edit $bname
  695.         saveAs -f $fname
  696.     }
  697. }
  698.  
  699.  
  700.  
  701.  
  702.  
  703.  
  704.  
  705.